COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	PROCEDURE INISCANNER
C00016 00004	!	initialization procedure 
C00018 00005	!	preswap,postswap
C00020 00006	!	exit procedure: endit
C00022 ENDMK
C⊗;
ENTRY;
BEGIN "INIT"

DEFINE $INIT=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;


STRING $USERNAME,$ALIAS_ID,$LOGIN_ID;
PROCEDURE INISCANNER;
	BEGIN
	INTEGER I;		
	FOR I←#MIN STEP 1 UNTIL #MAX DO $ENTRY[I]←0;
	STOKEN←FALSE;
	$TTYFL←NULL;
	$ALFL←"DECLAR.AL";		! default name for input/output file;
	$EPS←0.001;

	DEVICE←TTY_X;	! input is from teletype;
	TTYUP(TRUE);	! all input from teletype to be converted to UPPER case;
	END;

PROCEDURE INIOFFSET;
BEGIN
	ALEVENTOFF←'400;
	ARROFF[#SC]←'401;
	ARROFF[#VT]←'402;
	ARROFF[#RT]←ARROFF[#TR]←ARROFF[#FR]←'403;
 	ARROFF[#EV]←'404;		! ATTENTION;
 	$SYMOFF←'405;			! ATTENTION: CHECK RUNTIME;
END;

PROCEDURE TMPOFFSET;
BEGIN
	INTEGER ARRAY ARR[1:6];
	INTEGER I; ! make 9 new scalars because 10th is already made in AL;
	INTEGER INDEX;
	$TSCOFF←$SYMOFF;
	$TTROFF←$SYMOFF+10;
	$SYMOFF←$TTROFF+10;
	INDEX←0;
	FOR I←XMVAR,#SC,9,#RT,10,0 DO ARR[INDEX←INDEX+1]←I;
	$EXECUTE(αEXPR$(ARR,0));
END;

REQUIRE "⊂⊃⊂⊃" DELIMITERS;

REQUIRE "AIDEFS.SAI[PNT,HE]" SOURCE_FILE;

PROCEDURE INIMAXOFFSET;
	BEGIN
	INTEGER I;
	ARRCLR(OFFSET);	! clear data array of offsets;
	OFFSET[MAX_OFFSET,#SC]←NO_OF_SCALARS;
	OFFSET[MAX_OFFSET,#VT]←NO_OF_VECTORS;
	OFFSET[MAX_OFFSET,#FR]←OFFSET[MAX_OFFSET,#TR]←
		OFFSET[MAX_OFFSET,#RT]←NO_OF_TRANSES;
	OFFSET[MAX_OFFSET,#EV]←NO_OF_EVENTS;
	OFFSET[MAX_OFFSET,#MC]←NO_OF_MACROS;
	OFFSET[MAX_OFFSET,#FN]←NO_OF_FUNCTIONS;
	END;

REQUIRE UNSTACK_DELIMITERS;

PROCEDURE INIWORLD;
	BEGIN
	WORLD←ENSYM("STATION",#FR,F_WRLD←MK_REC(#FR));
	FRAME:PNAME[F_WRLD]←"STATION";
	END;

PROCEDURE SETOFFSET(INTEGER INDEX);
	BEGIN
	INTEGER I;
	IF INDEX≠CON_OFFSET AND INDEX≠PRG_OFFSET THEN OUTSTR("error in SETOFFSET")
	  ELSE FOR I←#MIN STEP 1 UNTIL #MAX 
		DO OFFSET[INDEX,I]←OFFSET[CUR_OFFSET,I];
	END;

PROCEDURE SAVRESOFFSET;
	BEGIN
	INTEGER I;
	FOR I←#MIN STEP 1 UNTIL #MAX DO OFFSET[RES_OFFSET,I]←$ENTRY[I];
	END;

PROCEDURE GTARMOFFSET;
	BEGIN
	INTEGER I,NILROTOFF,NILTRANSOFF;
IFC FALSE THENC 	ASKUSER("UNFIX BGRASP FROM BARM; ___ENDASKUSER"); ENDC
	ASKUSER("___ENDASKUSER");
	GTOKEN;
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	SYMBOL:OFFSET[HANDY←CHECK("YHAND",#SC)]←YHD_ALOFFSET;
	SYMBOL:INDEX[HANDY]←0;
	SYMBOL:OFFSET[HANDB←CHECK("BHAND",#SC)]←BHD_ALOFFSET;
	SYMBOL:INDEX[HANDB]←0;
	SYMBOL:OFFSET[YARM←CHECK("YARM",#FR)]←YRM_ALOFFSET;
	SYMBOL:INDEX[YARM]←0;
	SYMBOL:OFFSET[BARM←CHECK("BARM",#FR)]←BRM_ALOFFSET;
	SYMBOL:INDEX[BARM]←0;
	NILROTOFF←SYMBOL:INDEX[CHECK("NILROT",#RT)];
	NILTRANSOFF←SYMBOL:INDEX[CHECK("NILTRANS",#TR)];
	OFFSET[ARM_OFFSET,#SC]←OFFSET[CUR_OFFSET,#SC];
	OFFSET[ARM_OFFSET,#VT]←OFFSET[CUR_OFFSET,#VT];
	OFFSET[ARM_OFFSET,#RT]←NILROTOFF;
	OFFSET[ARM_OFFSET,#TR]←NILTRANSOFF;
	OFFSET[ARM_OFFSET,#FR]←OFFSET[CUR_OFFSET,#FR];
	ASKUSER("AFFIX BGRASP TO BARM AT TRANS(ROT(XHAT,-180),NILVECT); ___ENDASKUSER");
	GTOKEN;
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	END;



PROCEDURE INIBRK;
BEGIN
STRING BTABLE,LETDIGS;
BTABLE←":<>≤≥≡≠⊂⊃={}.,;[]()+-*/←↑↓→?α$|⊗"&LF&CR&TAB&FF&SP&dquote;
LETDIGS←"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890";
SETBREAK ($CRTAB ←GETBREAK,CR,LF&FF,"INSK");
SETBREAK ($FFTAB ←GETBREAK,FF,NULL,"INSK");
SETBREAK ($RETAB ←GETBREAK,BTABLE,NULL,"INR");		! used by gtoken;
SETBREAK ($SKTAB ←GETBREAK,BTABLE,NULL,"INS");
SETBREAK ($SPCTAB←GETBREAK,TAB&SP,NULL, "XNR");
SETBREAK ($ALFTAB←GETBREAK,NULL,NULL,"XRN");
SETBREAK ($NUMTAB←GETBREAK,"@+-0123456789",NULL,"XNR");	! as table 10;
SETBREAK ($DSHTAB←GETBREAK,"_",NULL,"INS");		! used by COPY/MERGE;
SETBREAK ($ERRTAB←GETBREAK,BTABLE,SP&CR,"IN");		! used while recovering;
SETBREAK ($BSKTAB←GETBREAK,NULL,SP,"IN");		! used to eliminate blanks;
SETBREAK ($DPYTAB←GETBREAK,CR,CRLF,"INS");		! used for display;
SETBREAK ($LTTAB← GETBREAK,LETDIGS,NULL,"INR");
SETBREAK ($NLTTAB←GETBREAK,LETDIGS,NULL,"XNR");
SETBREAK ($RBTAB← GETBREAK,NULL,RUBOUT,"IN");
$BLANK←"                                        ";
SETFORMAT(0,3);
END;

BOOLEAN PROCEDURE FILE_ABSENT(STRING FNAME);
BEGIN "check if FNAME exists"
	INTEGER INPCH,BRCHR,EOF;
	BOOLEAN E;
	OPEN(INPCH←GETCHAN,"DSK",0,3,0,1000,BRCHR,EOF);
	LOOKUP(INPCH,FNAME,EOF);
	E←EOF;
	RELEASE(INPCH);
	RETURN(E);
END;

PROCEDURE INIFILE;
BEGIN "read initialization file"
! check for initialization file on current area, and if absent, get from
	[PNT,HE];
	STRING FID;
	FID←"POINTY.INI";
	IF FILE_ABSENT(FID) THEN FID←FID&"[PNT,HE]";
	READCODE(FID);
END;

PROCEDURE CONSTDATA;
	BEGIN
	! read in and set up temporary scalars;
	ASKUSER("SCALAR "&RUBOUT&"I1, "&RUBOUT&"I2,"&RUBOUT&"I3, "&RUBOUT&"I4, "
			&RUBOUT&"I5; ___ENDASKUSER
");
	GTOKEN;
	SETOFFSET(PRG_OFFSET);
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	INIFILE;
	GTOKEN;
	WHILE NOT EQU(TOKEN,"_____END____INIT") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	END;

SIMPLE INTEGER PROCEDURE GETHOUR;
	RETURN( CALL(0,"TIMER") DIV 216000);

PROCEDURE INIMSG; 
BEGIN	"Print message of the day"
	STRING MESSGE;
	INTEGER BRCHAR,CHAN,EOF,FLAG;
	INTEGER FFBREAK;
	INTEGER HOUR; STRING $HOUR;
	IF (HOUR←GETHOUR)<12 THEN $HOUR←"Morning"
		 ELSE IF HOUR < 17 THEN $HOUR←"Afternoon"
			ELSE $HOUR←"Evening";
	PRINT("Hello..."&$USERNAME&"...Good "&$HOUR,CRLF);
	OPEN(CHAN←GETCHAN,"DSK",0,10,0,1000,BRCHAR,EOF);
	LOOKUP(CHAN,"PNTMSG.INI[PNT,HE]",FLAG);
	SETBREAK(FFBREAK←GETBREAK,FF,NULL,"ISN");
	MESSGE←INPUT(CHAN,FFBREAK);
	OUTSTR(MESSGE);
	RELEASE(CHAN);
	RELBREAK(FFBREAK);
END;

PROCEDURE GETUSERNAME;
α
	STRING LINE,WORD,GARB;
	INTEGER BRCHAR;
	INTEGER RCHAN,RBRCHAR,REOF,RFLAG;
	INTEGER CRBREAK,TABBREAK;
	STRING ID,ALIAS_NAME,LOGIN_NAME;
	ID←CVXSTR(CALL(0,"DSKPPN"));	! look at alias;
	$ALIAS_ID←ID[4 TO 6];
	ID←CVXSTR(CALL(0,"GETPPN"));	! look at login ppn;
	$LOGIN_ID←ID[4 TO 6];
	OPEN(RCHAN←GETCHAN,"DSK",0,2,0,1000,RBRCHAR,REOF);
	LOOKUP(RCHAN,"USERS.DAT[PNT,HE]",RFLAG);
	SETBREAK(CRBREAK←GETBREAK,'15,'12&'14,"ISN");
	SETBREAK(TABBREAK←GETBREAK,'11,'14,"ISN");
	WHILE NOT REOF DO
		α "GETALINE"
		STRING PN;
		LINE←INPUT(RCHAN,CRBREAK);
		PN←SCAN(LINE,TABBREAK,BRCHAR);
		IF EQU($ALIAS_ID,PN) THEN ALIAS_NAME←LINE;
		IF EQU($LOGIN_ID,PN) THEN LOGIN_NAME←LINE;
		β;
	RELBREAK(CRBREAK);
	RELBREAK(TABBREAK);
	RELEASE(RCHAN);
	IF ALIAS_NAME THEN $USERNAME←ALIAS_NAME
		ELSE IF LOGIN_NAME THEN $USERNAME←LOGIN_NAME
			ELSE α
				OUTSTR("I haven't met you before, what is your name?  ");
				$USERNAME←INCHWL;
				OUTSTR("Please send a message to MSM that you'd like POINTY to recognize you.
");			     β;

β;

PROCEDURE INIINTERRUPT;
BEGIN
intmap(15,esc_I,0);		! set mapping for interrupt handler;
enable(15);			! enable the interrupt handler;
$ESC_I←FALSE;
END;

PROCEDURE INIDISPLAY;
BEGIN
IFC #DISPL THENC INIDPY;ENDC
IFC #DISPL THENC ARRCLR($DISPLAYLIST,NULL); UPDATE;ENDC
END;


BOOLEAN WANT$SYSOUT;

PROCEDURE INIPHOTO;
BEGIN
EXTERNAL INTEGER INIACS;
IF MEMORY[LOCATION(INIACS)+3]=CVSIX("PNT HE")
	THEN BEGIN	! sys photo only if program is run from PNT HE ;
		$SYSFL←"POINTY.PHT[PNT,HE]";
		$SYSCH←ORAFILE($SYSFL,
			FF&"{ WRITTEN BY POINTY AT "&DAT_STR&" for ALIAS PPN = "&$ALIAS_ID
		&CRLF&" LOGIN PPN = "&$LOGIN_ID&" USERNAME = "&$USERNAME&"}"&CRLF,FALSE);
		IF $SYSCH=-1 THEN
			BEGIN PRINT("Terminal session will not be saved on system file",CRLF);
				$SYSOUT←FALSE;
			END ELSE $SYSOUT←TRUE;
		WANT$SYSOUT←$SYSOUT;
	     END
	ELSE WANT$SYSOUT←FALSE;
END;

SIMPLE PROCEDURE INITTYTYPE;
	BEGIN
	INTEGER I; STRING J;	J←TTYTYPE;
	FOR I←MAX_TTY STEP -1 UNTIL 1 DO IF EQU($TTYNAME[I],J) THEN DONE;
	$TTYTYPE←I;
	END;
!	initialization procedure ;
INTERNAL PROCEDURE INIT;
	BEGIN
	$ALLOW←1;	! dont do any displays ;
	GETUSERNAME;	! get the user name ;
	INIMSG;		! print initial message;
	ALINIT;
	INISCANNER;	! initialize the scanner;
	INIMAXOFFSET;	! initialize the offset tables;
	INIOFFSET;	! initialize arroff,varoff,byvar;
			! dont change order of above two because inimaxoffset
				clears the array;
	INIBRK;		! initialize break tables;
	INIWORLD;
	CONSTDATA;	! read in constant data;
	SETOFFSET(CON_OFFSET);
			! remember the current offsets;
	SAVRESOFFSET;
	GTARMOFFSET;	! keep offsets for arms;
	TMPOFFSET;	! set up temporary variables;
	$ALLOW←0;	! enable displays;
	INIINTERRUPT;	! set up interrupts - <esc> I ;
	INIDISPLAY;	! initialize display;
	INIPHOTO;	! initialize the recording session;
	INITTYTYPE;	! find out the terminal type;
	END;

REQUIRE INIT INITIALIZATION;
!	preswap,postswap;

!	these two routines are responsible for setting up things before saving
	the core image and swapping, and for setting up the i/o channels after
	swapping: they should be called only by the swap routine;

INTERNAL PROCEDURE PRESWAP;
BEGIN
! remember which channels are open, close all output files, complain about
	input files;
IF $OUT THEN CRAFILE($TTYCH);
IF $SYSOUT THEN CRAFILE($SYSCH);
REASSI(CALL(0,"PJOB"),"ELF");
END;


PROCEDURE REOPENFILES;
BEGIN
! setup desired channels again;
IF $OUT THEN 
    BEGIN $TTYCH←ORAFILE($TTYFL,"{ continued writing again at "&dat_str&"}"&CRLF,FALSE);
	IF $TTYCH=-1 THEN 
		BEGIN PRINT("WILL DISCONTINUE WRITING IN ",$TTYFL,CRLF);
			$OUT←FALSE; END;
    END;
IF WANT$SYSOUT THEN
BEGIN
$SYSCH←ORAFILE($SYSFL,"{ continued writing again at "&DAT_STR&"}"&CRLF,FALSE);
IF $SYSCH=-1 THEN
	BEGIN IF $SYSOUT THEN PRINT("WILL DISCONTINUE WRITING IN ",$SYSFL,CRLF);
		WANT$SYSOUT←$SYSOUT←FALSE;
	END;
END;
END;

INTERNAL PROCEDURE POSTSWAP;
BEGIN
REOPENFILES;
INIINTERRUPT;
REASSI(0,"ELF");
ALINIT;
END;
!	exit procedure: endit;

INTERNAL PROCEDURE ENDIT;
BEGIN
INTEGER HOUR; STRING $HOUR;
IF $SYSOUT THEN
	BEGIN
CPRINT($SYSCH,"{exiting at "&DAT_STR,CRLF,"	$FPMAX=",$FPMAX,CRLF,
	"	$INTMAX=",$INTMAX,CRLF,
	"	$PCDMAX=",$PCDMAX,"}",CRLF);
CRAFILE($SYSCH);
	END;

IF $OUT THEN BEGIN PRINT("CLOSING FILE ",$TTYFL); CRAFILE($TTYCH); END;
HOUR←GETHOUR;
BRK_N;

IF HOUR<5 THEN $HOUR←"please get some sleep, you've been working late"
	ELSE IF HOUR <15 THEN $HOUR←"have a nice day"
	ELSE IF HOUR <20 THEN $HOUR←"have a nice evening"
	ELSE $HOUR←"good night, and pleasant dreams";

PRINT("Bye,bye, ..."&$USERNAME&"... "&$HOUR,CRLF);
PRINT("Some interesting statistics:.....",CRLF,
	"$FPMAX=",$FPMAX,"; $INTMAX=",$INTMAX,";$PCDMAX=",$PCDMAX,CRLF);
LODED("dea elf"&CRLF&CRLF);	! to avoid forgetting to deassign;
CALL(1,"EXIT");			! allow continuation if desired ;
	! following code is executed in case user changes his mind and
		wants to continue where he left off;
REOPENFILES;
END;

END;